home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axdata / timer.bas < prev    next >
BASIC Source File  |  1997-09-15  |  2KB  |  62 lines
  1. Attribute VB_Name = "modTimer"
  2. '-------------------------------------------------------------------------------
  3. ' Copyright ⌐ 1997 Microsoft Corporation. All rights reserved.
  4. '
  5. ' You have a royalty-free right to use, modify, reproduce and distribute the
  6. ' Sample Application Files (and/or any modified version) in any way you find
  7. ' useful, provided that you agree that Microsoft has no warranty, obligations or
  8. ' liability for any Sample Application Files.
  9. '-------------------------------------------------------------------------------
  10.  
  11. '-------------------------------------------------------------------------------
  12. ' This module works hand-in-hand with the DropDownHelper class.
  13. '-------------------------------------------------------------------------------
  14.  
  15. Option Explicit
  16.  
  17. '-------------------------------------------------------------------------------
  18. 'Timer APIs:
  19.  
  20. Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
  21.     ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) _
  22.     As Long
  23. Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
  24.     ByVal nIDEvent As Long) As Long
  25.  
  26. '-------------------------------------------------------------------------------
  27. 'A list of pointers to timer objects. The list uses timer IDs as the keys.
  28.  
  29. Public gcTimerObjects As SortedList
  30.  
  31. '-------------------------------------------------------------------------------
  32. 'The timer code:
  33.  
  34. Private Sub TimerProc(ByVal lHwnd As Long, ByVal lMsg As Long, _
  35.     ByVal lTimerID As Long, ByVal lTime As Long)
  36.  
  37.     Dim nPtr As Long
  38.     Dim oTimerObject As objTimer
  39.  
  40. 'Debug.Print "TimerProc is firing"
  41.  
  42.     'Create a Timer object from the pointer
  43.     nPtr = gcTimerObjects.ItemByKey(lTimerID)
  44.     CopyMemory oTimerObject, nPtr, 4
  45.     'Call a method which will fire the Timer event
  46.     oTimerObject.Tick
  47.     'Get rid of the Timer object so that VB will not try to release it
  48.     CopyMemory oTimerObject, 0&, 4
  49. End Sub
  50.  
  51. Public Function StartTimer(lInterval As Long) As Long
  52.     StartTimer = SetTimer(0, 0, lInterval, AddressOf TimerProc)
  53. End Function
  54.  
  55. Public Sub StopTimer(lTimerID As Long)
  56.     KillTimer 0, lTimerID
  57. End Sub
  58.  
  59. Public Sub SetInterval(lInterval As Long, lTimerID As Long)
  60.     SetTimer 0, lTimerID, lInterval, AddressOf TimerProc
  61. End Sub
  62.